home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Source Code
/
Libraries
/
SAT 2.3.8
/
Libraries & Documentation
/
Add-ons
/
Graphic effects
/
AlphaSAT.p
next >
Wrap
Text File
|
1996-01-04
|
4KB
|
172 lines
{These routines set or reset the alpha channel in 32-bit color. It is of interest}
{when using SAT for mixing graphics with live video, using a video board that}
{supports the alpha channel.}
{This unit has not been tested much yet. Use with caution.}
{By Ingemar Ragnemalm 1995-1996.}
unit AlphaSAT;
interface
uses
SAT;
procedure SATFillAlphaRect (box: Rect; port: SATPort);
procedure SATPaintAlphaRect (box: Rect; port: SATPort; value: Integer);
procedure SATEraseAlphaRect (box: Rect; port: SATPort);
implementation
procedure SATFillAlphaRect (box: Rect; port: SATPort);
type
LongPtr = ^Longint;
var
savePort: SATPort;
globalBox: Rect;
pix: PixMapHandle;
h, v: Integer;
pixel: LongPtr;
maxV, maxH: integer;
begin
if not gSAT.colorFlag then
Exit(SATFillAlphaRect);
if port.device^^.gdPMap^^.pixelSize <> 32 then
Exit(SATFillAlphaRect);
SATGetPort(savePort);
SATSetPort(port);
globalBox := box;
LocalToGlobal(globalBox.topLeft);
LocalToGlobal(globalBox.botRight);
pix := port.device^^.gdPMap;
if box.bottom < port.port^.portRect.bottom then
maxV := box.bottom - 1
else
maxV := port.port^.portRect.bottom - 1;
if box.right < port.port^.portRect.right then
maxH := box.right - 1
else
maxH := port.port^.portRect.right - 1;
if box.left < maxH then
if box.top < maxV then
for v := box.top to maxV do
begin
pixel := LongPtr(Longint(pix^^.baseAddr) + BitAnd(pix^^.rowBytes, $3fff) * Longint(v) + 4 * box.left);
for h := box.left to maxH do
begin
pixel^ := BitOr(pixel^, $ff000000); {Fill}
pixel := LongPtr(Longint(pixel) + 4);
end;
end;
SATSetPort(savePort);
end; {SATFillAlphaRect}
procedure SATPaintAlphaRect (box: Rect; port: SATPort);
type
LongPtr = ^Longint;
var
savePort: SATPort;
globalBox: Rect;
pix: PixMapHandle;
h, v: Integer;
pixel: LongPtr;
maxV, maxH: integer;
theValue: Longint;
begin
if not gSAT.colorFlag then
Exit(SATPaintAlphaRect);
if port.device^^.gdPMap^^.pixelSize <> 32 then
Exit(SATPaintAlphaRect);
SATGetPort(savePort);
SATSetPort(port);
{Shift value to the right place - the most significant byte}
theValue := BSL(value, 24);
globalBox := box;
LocalToGlobal(globalBox.topLeft);
LocalToGlobal(globalBox.botRight);
pix := port.device^^.gdPMap;
if box.bottom < port.port^.portRect.bottom then
maxV := box.bottom - 1
else
maxV := port.port^.portRect.bottom - 1;
if box.right < port.port^.portRect.right then
maxH := box.right - 1
else
maxH := port.port^.portRect.right - 1;
if box.left < maxH then
if box.top < maxV then
for v := box.top to maxV do
begin
pixel := LongPtr(Longint(pix^^.baseAddr) + BitAnd(pix^^.rowBytes, $3fff) * Longint(v) + 4 * box.left);
for h := box.left to maxH do
begin
pixel^ := BitOr(pixel^, theValue); {Paint}
pixel := LongPtr(Longint(pixel) + 4);
end;
end;
SATSetPort(savePort);
end; {SATPaintAlphaRect}
procedure SATEraseAlphaRect (box: Rect; port: SATPort);
type
LongPtr = ^Longint;
var
savePort: SATPort;
globalBox: Rect;
pix: PixMapHandle;
h, v: Integer;
pixel: LongPtr;
maxV, maxH: integer;
begin
if not gSAT.colorFlag then
Exit(SATEraseAlphaRect);
if port.device^^.gdPMap^^.pixelSize <> 32 then
Exit(SATEraseAlphaRect);
SATGetPort(savePort);
SATSetPort(port);
globalBox := box;
LocalToGlobal(globalBox.topLeft);
LocalToGlobal(globalBox.botRight);
pix := port.device^^.gdPMap;
if box.bottom < port.port^.portRect.bottom then
maxV := box.bottom - 1
else
maxV := port.port^.portRect.bottom - 1;
if box.right < port.port^.portRect.right then
maxH := box.right - 1
else
maxH := port.port^.portRect.right - 1;
if box.left < maxH then
if box.top < maxV then
for v := box.top to maxV do
begin
pixel := LongPtr(Longint(pix^^.baseAddr) + BitAnd(pix^^.rowBytes, $3fff) * Longint(v) + 4 * box.left);
for h := box.left to maxH do
begin
pixel^ := BitAnd(pixel^, $00ffffff); {Erase}
pixel := LongPtr(Longint(pixel) + 4);
end;
end;
SATSetPort(savePort);
end; {SATEraseAlphaRect}
end.